home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / print.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  7.7 KB  |  342 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: print.c,v 1.14 94/11/28 15:00:57 wlott Exp $
  27. *
  28. * This file implements the printer framework.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "obj.h"
  36. #include "class.h"
  37. #include "bool.h"
  38. #include "list.h"
  39. #include "print.h"
  40. #include "vec.h"
  41. #include "char.h"
  42. #include "str.h"
  43. #include "thread.h"
  44. #include "func.h"
  45. #include "def.h"
  46. #include "sym.h"
  47. #include "error.h"
  48. #include "num.h"
  49. #include "type.h"
  50.  
  51. void def_printer(obj_t class, void (*print_fn)(obj_t object))
  52. {
  53.     obj_ptr(struct class *, class)->print = print_fn;
  54. }
  55.  
  56. static int depth = 0;
  57.  
  58. void prin1(obj_t object)
  59. {
  60.     obj_t class = object_class(object);
  61.     obj_t cpl = obj_ptr(struct class *, class)->cpl;
  62.     obj_t debug_name;
  63.  
  64.     if (depth > 10) {
  65.     putchar('#');
  66.     return;
  67.     }
  68.  
  69.     depth++;
  70.  
  71.     if (cpl) {
  72.     while (cpl != obj_Nil) {
  73.         void (*print_fn)(obj_t object)
  74.         = obj_ptr(struct class *, HEAD(cpl))->print;
  75.  
  76.         if (print_fn != NULL) {
  77.         print_fn(object);
  78.         depth--;
  79.         return;
  80.         }
  81.  
  82.         cpl = TAIL(cpl);
  83.     }
  84.     }
  85.  
  86.     debug_name = obj_ptr(struct class *, class)->debug_name;
  87.     if (debug_name != NULL && debug_name != obj_False)
  88.     printf("{%s 0x%08lx}", sym_name(debug_name), (unsigned long)object);
  89.     else
  90.     printf("{0x%08lx}", (unsigned long)object);
  91.  
  92.     depth--;
  93. }
  94.  
  95. void print(obj_t object)
  96. {
  97.     prin1(object);
  98.     putchar('\n');
  99. }
  100.  
  101. static void vvformat(char *fmt, va_list ap)
  102. {
  103.     int args = count_format_args(fmt);
  104.     obj_t vec = make_vector(args, NULL);
  105.     int i;
  106.  
  107.     for (i = 0; i < args; i++)
  108.     SOVEC(vec)->contents[i] = va_arg(ap, obj_t);
  109.  
  110.     vformat(fmt, SOVEC(vec)->contents, args);
  111. }
  112. #if _USING_PROTOTYPES_
  113. void format(char *fmt, ...)
  114. {
  115.     va_list ap;
  116.  
  117.     va_start(ap, fmt);
  118.     vvformat(fmt, ap);
  119.     va_end(ap);
  120. }
  121. #else
  122. void format(va_alist) va_dcl
  123. {
  124.     va_list ap;
  125.     char *fmt;
  126.  
  127.     va_start(ap);
  128.     fmt = va_arg(ap, char *);
  129.     vvformat(fmt, ap);
  130.     va_end(ap);
  131. }
  132. #endif
  133.  
  134. int count_format_args(char *fmt)
  135. {
  136.     char *ptr;
  137.     int args = 0;
  138.  
  139.     for (ptr = fmt; *ptr != '\0'; ptr++) {
  140.     if (*ptr == '%') {
  141.         switch (*++ptr) {
  142.               case 'd': case 'D':
  143.           case 'b': case 'B':
  144.           case 'o': case 'O':
  145.           case 'x': case 'X':
  146.           case 'c': case 'C':
  147.           case 's': case 'S':
  148.           case '=':
  149.         args++;
  150.         break;
  151.           case '%':
  152.         break;
  153.           default:
  154.         error("Unknown format directive in error msg: %%%c", 
  155.               int_char(*ptr));
  156.         }
  157.     }
  158.     }
  159.  
  160.     return args;
  161. }
  162.  
  163. /* Works only for numbers greater than 0. If zero, prints nothing. */
  164.  
  165. void print_nonzero_in_binary(int number)
  166. {
  167.     if (number != 0) {
  168.     print_nonzero_in_binary(number >> 1);
  169.     fputc('0' + (number & 1), stdout);  /* Extract the low bit 
  170.                                                and convert to ASCII */
  171.     }
  172. }
  173.  
  174. void print_number_in_binary(int number)
  175. {
  176.     if (number == 0)
  177.     fputc('0', stdout);
  178.     else
  179.     print_nonzero_in_binary(number);
  180. }
  181.  
  182. void vformat(char *fmt, obj_t *args, int nargs)
  183. {
  184.     while (*fmt != '\0') {
  185.     if (*fmt == '%') {
  186.         switch (*++fmt) {
  187.               case 'd':
  188.           case 'D':
  189.         if (--nargs < 0)
  190.             error("Not enough arguments to format");
  191.         check_type(*args, obj_IntegerClass);
  192.         if (obj_is_fixnum(*args))
  193.             fprintf(stdout, "%ld", fixnum_value(*args++));
  194.         else
  195.             print_bignum(*args++, 10);
  196.         break;
  197.               case 'b':
  198.           case 'B':
  199.         if (--nargs < 0)
  200.             error("Not enough arguments to format");
  201.         check_type(*args, obj_IntegerClass);
  202.         if (obj_is_fixnum(*args))
  203.             print_number_in_binary(fixnum_value(*args++));
  204.         else
  205.             print_bignum(*args++, 2);
  206.         break;
  207.               case 'o':
  208.           case 'O':
  209.         if (--nargs < 0)
  210.             error("Not enough arguments to format");
  211.         check_type(*args, obj_IntegerClass);
  212.         if (obj_is_fixnum(*args))
  213.             fprintf(stdout, "%lo", fixnum_value(*args++));
  214.         else
  215.             print_bignum(*args++, 8);
  216.         break;
  217.               case 'x':
  218.           case 'X':
  219.         if (--nargs < 0)
  220.             error("Not enough arguments to format");
  221.         check_type(*args, obj_IntegerClass);
  222.         if (obj_is_fixnum(*args))
  223.             fprintf(stdout, "%lx", fixnum_value(*args++));
  224.         else
  225.             print_bignum(*args++, 16);
  226.         break;
  227.           case 'c':
  228.           case 'C':
  229.         if (--nargs < 0)
  230.             error("Not enough arguments to format");
  231.         check_type(*args, obj_CharacterClass);
  232.         fputc(char_int(*args++), stdout);
  233.         break;
  234.           case '=':
  235.         if (--nargs < 0)
  236.             error("Not enough arguments to format");
  237.         prin1(*args++);
  238.         break;
  239.           case 's':
  240.           case 'S':
  241.         /* Gotta somehow have two cases,          */
  242.         /* one for strings and another for errors */
  243.         if (--nargs < 0)
  244.             error("Not enough arguments to format");
  245.         if (instancep(*args, obj_ByteStringClass)) {
  246.             fputs((char *)string_chars(*args++), stdout);
  247.         }
  248.         else if (instancep(*args, obj_SymbolClass)) {
  249.             fputs((char *)sym_name(*args++), stdout);
  250.         }
  251.         /* Can't print conditions, because they are defined in */
  252.         /* dylan. */
  253.         else {
  254.           error("%= is neither a string nor a symbol,"
  255.             " and so can't be printed with %%s", *args++);
  256.         }
  257.         break;
  258.           case '%':
  259.         putchar('%');
  260.         break;
  261.           default:
  262.         error("Unknown format directive in error msg: %%%c", 
  263.               int_char(*fmt));
  264.           }
  265.     }
  266.     else
  267.         putchar(*fmt);
  268.     fmt++;
  269.     }
  270. }
  271.  
  272.  
  273. /* Dylan routines */
  274.  
  275. static obj_t dylan_print(obj_t obj)
  276. {
  277.     print(obj);
  278.     return obj;
  279. }
  280.  
  281. static obj_t dylan_prin1(obj_t obj)
  282. {
  283.     prin1(obj);
  284.     return obj;
  285. }
  286.  
  287. static obj_t dylan_putc(obj_t obj)
  288. {
  289.     putchar(char_int(obj));
  290.     return obj;
  291. }
  292.  
  293. static obj_t dylan_puts(obj_t obj)
  294. {
  295.     fputs((char *)string_chars(obj), stdout);
  296.     return obj;
  297. }
  298.  
  299. static void dylan_format(struct thread *thread, int nargs)
  300. {
  301.     obj_t *args = thread->sp - nargs;
  302.     obj_t *old_sp;
  303.     obj_t fmt = args[0];
  304.  
  305.     push_linkage(thread, args);
  306.  
  307.     check_type(fmt, obj_ByteStringClass);
  308.  
  309.     vformat((char *)string_chars(fmt), args+1, nargs-1);
  310.  
  311.     old_sp = pop_linkage(thread);
  312.     thread->sp = old_sp;
  313.  
  314.     do_return(thread, old_sp, old_sp);
  315. }
  316.  
  317. static obj_t dylan_fflush()
  318. {
  319.     fflush(stdout);
  320.     return obj_False;
  321. }
  322.  
  323.  
  324. /* Init stuff. */
  325.  
  326. void init_print_functions(void)
  327. {
  328.     define_function("print", list1(obj_ObjectClass), FALSE, obj_False, FALSE,
  329.             obj_ObjectClass, dylan_print);
  330.     define_function("prin1", list1(obj_ObjectClass), FALSE, obj_False, FALSE,
  331.             obj_ObjectClass, dylan_prin1);
  332.     define_function("putc", list1(obj_CharacterClass), FALSE, obj_False, FALSE,
  333.             obj_CharacterClass, dylan_putc);
  334.     define_function("puts", list1(obj_ByteStringClass), FALSE, obj_False,
  335.             FALSE, obj_ByteStringClass, dylan_puts);
  336.     define_constant("format",
  337.             make_raw_function("format", 1, TRUE, obj_False, FALSE,
  338.                       obj_Nil, obj_False, dylan_format));
  339.     define_function("fflush", obj_Nil, FALSE, obj_False, FALSE,
  340.             obj_ObjectClass, dylan_fflush);
  341. }
  342.